
{*
  Object Pascal simple debuging and tracing routines
  @author  Maciej Zagozda (1998-2008)
  @licence Microsoft Reciprocal License (Ms-RL)
  @website http://www.codeplex.com/intelitechdelphirtns/
  @version 2008/04/20 Added documentation support
  @version 2008/05/12 Major code reorganisation and clean-up
}

unit ExceptionRoutines;

interface

uses
  Classes,
  Controls,
  ComCtrls,
  DBTables,
  Graphics,
  Forms,
  Dialogs,
  ExtCtrls,
  INIFiles,
  Messages,
  Registry,
  ShellApi,
  SysUtils,
  StdCtrls,
  Windows;

var
  MODE_DEBUG: Boolean;
  MODE_DEBUG_COMPANY: AnsiString;
  MODE_DEBUG_PRODUCT: AnsiString;

// closes local event log
function CloseProgramLines: Boolean;

// creates local event log
function OpenProgramLines: Boolean;

// appends string to local event log
function SetProgramLine( strnString: AnsiString ): Boolean;

// appends error message to local event log
function SetProgramError( strnMessage, strnException, strnParameter1, strnParameter2: ShortString ): Boolean;

function DisplayException( const strMessage: AnsiString; const strException: AnsiString ): Boolean; overload;
function DisplayException( const strTitle, strMessage: AnsiString; dbeException: EDBEngineError): Boolean; overload;

function ShowErrorDialog(strTitle: AnsiString; const strMessage: AnsiString; const strDetails1: AnsiString = ''; const strDetails2: AnsiString = ''; const blnShowSend: Boolean = False): Integer;

implementation

uses
  //CurrencyRoutines,
  //DateRoutines,
  FileRoutines,
  //FloatRoutines,
  FolderRoutines,
  IntegerRoutines,
  MessageRoutines,
  StringRoutines,
  SoundRoutines,
  SystemRoutines,

  pasInfoDialog;

  //srcDefaultInterface;
  //srcProgramConstants;

var
  fileX: TextFile;

function OpenProgramLines: Boolean;
var
  strnFileName: AnsiString;
begin
  if ( MODE_DEBUG ) and ( Length( MODE_DEBUG_COMPANY ) > 0 ) and ( Length( MODE_DEBUG_PRODUCT ) > 0 ) then
  begin
    Result := True;

    strnFileName := GetUserFile( MODE_DEBUG_COMPANY, MODE_DEBUG_PRODUCT, FormatDateTime( 'yyyymmddhhnnss', Now ) + '.log' );
    //ShowMessage(strnFileName);
    try
      AssignFile( fileX, strnFileName );
      Rewrite( fileX );
    except
      Result := False;
    end;//try
  end
  else
  begin
    Result := False;
  end;//if
end;

function CloseProgramLines: Boolean;
begin
  Result := True;
  try
    if ( MODE_DEBUG ) and ( Length( MODE_DEBUG_COMPANY ) > 0 ) and ( Length( MODE_DEBUG_PRODUCT ) > 0 ) then
    begin
      CloseFile( fileX );
    end
    else
    begin
      Result := False;
    end;//if
  except
    Result := False;
  end;//try
end;//

function SetProgramLine( strnString: AnsiString ): Boolean;
begin
  Result := True;
  if ( MODE_DEBUG ) and ( Length( MODE_DEBUG_COMPANY ) > 0 ) and ( Length( MODE_DEBUG_PRODUCT ) > 0 ) = True then
  begin
    //frmDefaultInterface.memDebug.Lines.Add( strnString );
    try
      WriteLn( fileX, strnString );
      Flush( fileX );
    except
      Result := False;
    end;//try
  end
  else
  begin
    Result := False;
  end;//if

end;

function ShowErrorDialog(strTitle: AnsiString; const strMessage: AnsiString; const strDetails1: AnsiString = ''; const strDetails2: AnsiString = ''; const blnShowSend: Boolean = False): Integer;
begin

  if Length(Trim( strTitle )) =0 then strTitle := Application.Title;

  frmInfoDialog := TfrmInfoDialog.Create( Application );

  try
    with frmInfoDialog do
    begin
      Caption := strTitle;
      lblMessage.Caption := strMessage;

      ShowSend := (blnShowSend) and (Length(STR_SUPPORT_MESSAGE) > 0);

      // Append details

      lstDetails.Items.Clear;
      if Length(strDetails1) > 0 then
      begin
        lstDetails.Items.Add( strDetails1 );
      end;//if

      if Length(strDetails2) >0 then
      begin
        lstDetails.Items.Add( strDetails2 );
      end;//if

      btnDetails.Enabled := Length(strDetails1) >0;

      ShowModal;
    end;//with
  finally
    frmInfoDialog.Free;
  end;//try

  Result := 0;
end;

function SetProgramError( strnMessage, strnException, strnParameter1, strnParameter2: ShortString ): Boolean;
begin
end;

function DisplayException( const strMessage: AnsiString; const strException: AnsiString ): Boolean;
begin
  MessageDlg(Format( strMessage, [strException] ), mtError, [mbOK], 0);
  Result := True;
end;//with

function DisplayException( const strTitle, strMessage: AnsiString; dbeException: EDBEngineError): Boolean;
var
  intA: Integer;
  strDetails: AnsiString;
begin

  strDetails := '';
  for intA := 0 to Pred(dbeException.ErrorCount) do

  begin
    strDetails := strDetails + Format('%d,%d - %s', [dbeException.Errors[intA].ErrorCode, dbeException.Errors[intA].NativeError, dbeException.Errors[intA].Message] ) + #13#10;
  end;//for

  ShowErrorDialog( strTitle, strMessage, 'Database returned error', strDetails ); 

end;

end.
